#
# Kurella/Rapp: The role of issue salience and competitive advantages in spatial models of political competition
#
# Replication Material: Figures 1 and 2
#
#
######################################
 



# Packages
library(haven)
library(basicspace)
library(survival)
library(MASS)
library(RColorBrewer)



set.seed(901)

# Functions

# Function: Votes ~ Salience

###############################
# v: voter ideal points n x k #  
# p: party positionsj x k     #
# b: salience parameter       #
# a: valence                  #
###############################


max.util <- function (v, p, b1, b2, a){
        
        n <- length(v[,1])
        k <- length(p[,1])
        
        dist1 <- sqrt( (v[,1]*matrix(1,n,k)-t(matrix(1,k,n)*p[,1]))^2 )
        dist2 <- sqrt( (v[,2]*matrix(1,n,k)-t(matrix(1,k,n)*p[,2]))^2 )
        
        a_mat <- matrix(rep(a,n), nrow=n, byrow=TRUE)
        
        vu <- a_mat - ( b1* dist1^2 + b2*dist2^2 ) 
        
        m.util <- rep(0,n,k)
        for(i in 1:n){
                if(length(which(vu[i,]==max(vu[i,])))>1)   m.util[i] <- sample(which(vu[i,]==max(vu[i,])),1)
                if(length(which(vu[i,]==max(vu[i,])))==1)  m.util[i] <- which(vu[i,]==max(vu[i,]))}
        
        return( list(vote=m.util, d1=dist1, d2=dist2))
} 

######################################################


# Data preparation

 
# load data
d <- read_dta("ZA7700_v1-0-0.dta")     # GLES 2021


# ID Variable
d$id <- d$lfdn


# Issue items for voters and perceived positions of parties



#######################################################
#
#
# Issue item: econ
#
#

# q39b-f, q40: Positionsissue Steuern vs. Sozialleistungen


d$econ_ego   <- ifelse(d$q40>0, d$q40, NA)
d$econ_cdu   <- ifelse(d$q39b>0, d$q39b, NA)
d$econ_csu   <- ifelse(d$q39c>0, d$q39c, NA)
d$econ_spd   <- ifelse(d$q39d>0, d$q39d, NA)
d$econ_fdp   <- ifelse(d$q39e>0, d$q39e, NA)
d$econ_gru   <- ifelse(d$q39f>0, d$q39f, NA)
d$econ_lin   <- ifelse(d$q39g>0, d$q39g, NA)
d$econ_afd   <- ifelse(d$q39h>0, d$q39h, NA)



# Replace CDU in Bavaria with CSU

d$econ_cdu[d$bula==9] <- d$econ_csu[d$bula==9]



#
# Prepare Aldrich-McKelvey rescaling
#



# issue item matrix
mat <- cbind(d$econ_ego,
             d$econ_cdu,
             d$econ_spd,
             d$econ_fdp,
             d$econ_gru,
             d$econ_lin,
             d$econ_afd)

# short party labels
colnames(mat) <- c("ego", 
                   "cdu",
                   "spd",
                   "fdp",
                   "gru",
                   "lin",
                   "afd")


left <- 6


# how many missings per respondent to impute: 

mi <- 2

k <- dim(mat)[2]


# Aldrich-McKelvey rescaling 
#------------------------------------------ 
n <- dim(d)[1]
p <- apply(mat,2,mean,na.rm=TRUE)
repl <- ifelse(rowSums(is.na(mat[,2:k]))>0&rowSums(is.na(mat[,2:k]))<=mi,1,0)
for(i in 1:n){
        if(repl[i]==1){
                for(j in 2:k){
                        if(is.na(mat[i,k])){mat[i,k] <- p[k]}    
                } }  }


econ_am <- aldmck(mat, respondent=1, polarity=left)
#-------------------------------------------------------------------


# add rescaled party and voter positions to dataframe


# ego        
d$econ_ego_am <- ifelse(econ_am$respondents[,3]>c(-3)&econ_am$respondents[,3]<3,econ_am$respondents[,3], NA)

d$econ_cdu_am  <- econ_am$stimuli[1]
d$econ_spd_am  <- econ_am$stimuli[2]
d$econ_fdp_am   <- econ_am$stimuli[3]
d$econ_gru_am   <- econ_am$stimuli[4]
d$econ_lin_am   <- econ_am$stimuli[5]
d$econ_afd_am   <- econ_am$stimuli[6]
 





#######################################################
#
#
# Issue item: immigration
#
#

# q42b-f, q43: Zuwanderung erleichtern vs erschweren



d$immi_ego   <- ifelse(d$q43>0, d$q43, NA)
d$immi_cdu   <- ifelse(d$q42b>0, d$q42b, NA)
d$immi_csu   <- ifelse(d$q42c>0, d$q42c, NA)
d$immi_spd   <- ifelse(d$q42d>0, d$q42d, NA)
d$immi_fdp   <- ifelse(d$q42e>0, d$q42e, NA)
d$immi_gru   <- ifelse(d$q42f>0, d$q42f, NA)
d$immi_lin   <- ifelse(d$q42g>0, d$q42g, NA)
d$immi_afd   <- ifelse(d$q42h>0, d$q42h, NA)


d$immi_cdu[d$bula==9] <- d$immi_csu[d$bula==9]



#
# Prepare Aldrich-McKelvey rescaling
#



# issue item matrix
mat <- cbind(d$immi_ego,
             d$immi_cdu,
             d$immi_spd,
             d$immi_fdp,
             d$immi_gru,
             d$immi_lin,
             d$immi_afd)

# short party labels
colnames(mat) <- c("ego", 
                   "cdu",
                   "spd",
                   "fdp",
                   "gru",
                   "lin",
                   "afd")



left <- 6

mi <- 2



# Aldrich-McKelvey rescaling 
#------------------------------------------ 
n <- dim(d)[1]
k <- dim(mat)[2]
p <- apply(mat,2,mean,na.rm=TRUE)
repl <- ifelse(rowSums(is.na(mat))>0&rowSums(is.na(mat))<=mi,1,0)
for(i in 1:n){
        if(repl[i]==1){
                for(j in 2:k){
                        if(is.na(mat[i,k])){mat[i,k] <- p[k]}    
                } }  }


immi_am <- aldmck(mat, respondent=1, polarity=left)
#-------------------------------------------------------------------

 
# add rescaled party and voter positions to dataframe


# ego        
d$immi_ego_am <- ifelse(immi_am$respondents[,3]>c(-3)&immi_am$respondents[,3]<3,immi_am$respondents[,3], NA)

d$immi_cdu_am  <- immi_am$stimuli[1]
d$immi_spd_am  <- immi_am$stimuli[2]
d$immi_fdp_am   <- immi_am$stimuli[3]
d$immi_gru_am   <- immi_am$stimuli[4]
d$immi_lin_am   <- immi_am$stimuli[5]
d$immi_afd_am   <- immi_am$stimuli[6]




#
#
#  
#
#####################################################################################





X <- d








# Analysis: vote shares depending on relative Salience 

##############################################################################
#
#
#   
#
 




voters <- matrix(c(X$econ_ego_am, X$immi_ego_am), ncol=2)
voters <- voters[!is.na(rowSums(voters)),]

n <- dim(voters)[1]
valence <- c(1,1,1,1,1,1)

erg <- matrix(0, ncol=8, nrow=100)
parties <- matrix(c(econ_am$stimuli,  
                    immi_am$stimuli), ncol=2)
B1 <- seq(1,0,length.out=100)
B2 <- seq(0,1,length.out=100)  

for( i in 1:100){
        k <- length(parties[,1])
        beta2 <- B2[i]
        beta1 <- B1[i]
        
        y <- max.util(v=voters, p=parties, b1=beta1, b2=beta2, a=valence)  
        d <- as.data.frame(cbind(y$d1, y$d2, y$vote))
        
        
        erg[i,1:6] <- table(d$V13)
        
        
       erg[i,7] <- (beta2/beta1)^(1/2)
        erg[i,8] <- i
}

erg <- as.data.frame(erg)

names(erg) <- c("p1", "p2", "p3", "p4", "p5", "p6", "beta", "n")











############ Figure 1 ##################


mycol <- brewer.pal("Pastel1", n=7)[c(1:5,7)][c(2,1,5,3,4,6)]


f1 <- kde2d(voters[,1], 
            voters[,2],
            n = 150, lims = c(-1.2,1.2, -1.2, 1.2))



par(mfrow=c(2,2), cex=1, mar=c(4,4,4,1))

i <- 1
beta2 <- B2[i]
beta1 <- B1[i]
xy <- matrix(c(runif(80000,-1.2,1.2)), ncol=2)
y <- max.util(v=xy, p=parties, b1=beta1, b2=beta2, a=valence)  
d <- as.data.frame(cbind(y$d1, y$d2, y$vote))


plot(xy[d$V13==1,] , pch=19, col=mycol[1], 
     xlab="Economic dimension", ylab="Immigration dimension",
     main=bquote("a) "~  beta[econ]  == 1 ~ "and " ~ ~ beta[immi] == 0), 
     xlim=c(-1,1), ylim=c(-1,1))
points(xy[d$V13==2,], pch=19, col=mycol[2])
points(xy[d$V13==3,], pch=19, col=mycol[3])
points(xy[d$V13==4,], pch=19, col=mycol[4])
points(xy[d$V13==5,], pch=19, col=mycol[5])
points(xy[d$V13==6,], pch=19, col=mycol[6])
points(parties, pch=19)
text(parties, c("C", "S", "F", "G", "L", "A"), 
     pos=c(1,1,3,1,2,1), cex=1.2)
contour(f1, levels  =  c(0.05, 0.1,0.2, 0.4, 0.6,0.8) ,add = T, lty=3)
box()



i <- 50
beta2 <- B2[i]
beta1 <- B1[i]
y <- max.util(v=xy, p=parties, b1=beta1, b2=beta2, a=valence)  
d <- as.data.frame(cbind(y$d1, y$d2, y$vote))

plot(xy[d$V13==1,] , pch=19, col=mycol[1], 
     xlab="Economic dimension", ylab="Immigration dimension",
     main=bquote("b) "~  beta[econ]  == 0.5 ~ "and " ~ ~ beta[immi] == 0.5), 
     xlim=c(-1,1), ylim=c(-1,1))
points(xy[d$V13==2,], pch=19, col=mycol[2])
points(xy[d$V13==3,], pch=19, col=mycol[3])
points(xy[d$V13==4,], pch=19, col=mycol[4])
points(xy[d$V13==5,], pch=19, col=mycol[5])
points(xy[d$V13==6,], pch=19, col=mycol[6])
points(parties, pch=19)
text(parties, c("C", "S", "F", "G", "L", "A"), 
     pos=c(1,1,3,1,2,1), cex=1.2)
contour(f1, levels  =  c(0.05, 0.1,0.2, 0.4, 0.6,0.8) ,add = T, lty=3)

box()




i <- 75
beta2 <- B2[i]
beta1 <- B1[i]
y <- max.util(v=xy, p=parties, b1=beta1, b2=beta2, a=valence)  
d <- as.data.frame(cbind(y$d1, y$d2, y$vote))

plot(xy[d$V13==1,] , pch=19, col=mycol[1], 
     xlab="Economic dimension", ylab="Immigration dimension",
     main=bquote("c) "~  beta[econ]  == 0.25 ~ "and " ~ ~ beta[immi] == 0.75), 
     xlim=c(-1,1), ylim=c(-1,1))
points(xy[d$V13==2,], pch=19, col=mycol[2])
points(xy[d$V13==3,], pch=19, col=mycol[3])
points(xy[d$V13==4,], pch=19, col=mycol[4])
points(xy[d$V13==5,], pch=19, col=mycol[5])
points(xy[d$V13==6,], pch=19, col=mycol[6])
points(parties, pch=19)
text(parties, c("C", "S", "F", "G", "L", "A"), 
     pos=c(1,1,3,1,2,1), cex=1.2)
contour(f1, levels  =  c(0.05, 0.1,0.2, 0.4, 0.6,0.8) ,add = T, lty=3)
box()



i <- 100
beta2 <- B2[i]
beta1 <- B1[i]
y <- max.util(v=xy, p=parties, b1=beta1, b2=beta2, a=valence)  
d <- as.data.frame(cbind(y$d1, y$d2, y$vote))

plot(xy[d$V13==1,] , pch=19, col=mycol[1], 
     xlab="Economic dimension", ylab="Immigration dimension",
     main=bquote("d) "~  beta[econ]  == 0 ~ "and " ~ ~ beta[immi] == 1), 
     xlim=c(-1,1), ylim=c(-1,1))
points(xy[d$V13==2,], pch=19, col=mycol[2])
points(xy[d$V13==3,], pch=19, col=mycol[3])
points(xy[d$V13==4,], pch=19, col=mycol[4])
points(xy[d$V13==5,], pch=19, col=mycol[5])
points(xy[d$V13==6,], pch=19, col=mycol[6])
points(parties, pch=19)
text(parties, c("C", "S", "F", "G", "L", "A"), 
     pos=c(1,1,3,1,2,1), cex=1.2)
contour(f1, levels  =  c(0.05, 0.1,0.2, 0.4, 0.6,0.8) ,add = T, lty=3)
box()




############## Figure 2 #############################################

mycol <- brewer.pal("Set1", n=7 )[c(1:5,7)][c(2,1,5,3,4,6)]
par(mfrow=c(1,1), mar=c(5,5,1,1), cex=1.5)
plot(erg$p1/n ~ erg$n, type="l", lwd=2,
     col=mycol[1], lty=1,
     ylim=c(0,0.3), xlim=c(0,100), main="", 
     xlab=expression( (beta[immi] / beta[econ])),
     ylab="Vote shares", axes=FALSE)
axis(1, at=c(1,25,50,75,100), 
     labels=c("(0 / 1)", "(0.25 / 0.75)", "(0.5 / 0.5)", 
              "(0.75 / 0.25)", "(1 / 0)"))
axis(2)
lines(erg$n, erg$p2/n,  lwd=2,lty="dashed",col=mycol[2])
lines(erg$n, erg$p3/n,  lwd=4,lty="solid", col=mycol[3])
lines(erg$n, erg$p4/n,  lwd=2,lty="dotdash", col=mycol[4])
lines(erg$n, erg$p5/n,  lwd=2,lty="longdash", col=mycol[5])
lines(erg$n, erg$p6/n,  lwd=4, lty="twodash", col=mycol[6])
legend("top", c("CDU", "SPD", "FDP", "Greens", "Linke", "AfD"),
       col=mycol, lty=c("solid","dashed", "solid","dotdash","longdash","twodash"), lwd=c(2,2,4,2,2,4),cex=0.8,
       horiz=TRUE, bty="n")
box()
